perm filename PLTIT.F4[XX,LCS] blob
sn#231779 filedate 1976-08-14 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 C**** PLTCMD, FILLMS ********
C00009 ENDMK
Cā;
C**** PLTCMD, FILLMS ********
SUBROUTINE PLTCMD
COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK /OUTF/JJ
DIMENSION NMS(15),RMOV1(15),RMOV2(15)
COMMON /DL/RSIZ,SAVER,NAME /ALF/INP(72),ML
COMMON R2,JE,CENTR,JB,RJQ(20),JQ(20)
EQUIVALENCE (R5,RJQ(3)),(R6,RJQ(4)),(R7,RJQ(5)),(R4,RJQ(2))
1,(R3,RJQ(1)),(I2,INP(2)),(R8,RJQ(6)),(R9,RJQ(7))
C BE CAREFUL OF COMMON OVERLAPS WITH NOTWRT,ITMSUB,HOMER, ETC.
F78F(1)='(78F)'
FA5(1)='(A5) '
FA1(1)='(A1) '
IF(I2.NE.'X')GO TO 1
I2=0
RXC=0
RMOV1(1)='Y'
NAME=0
14 KA=0
3 KA=KA+1
IF(MLL.EQ.0)GO TO 15
K=K-2
MLL=MLL-1
IF(MLL.EQ.0)GO TO 10
GO TO 31
15 TYPE 2,KA
ACCEPT 11,K,MLL,RSPC
C TYPE LAST NAME, NUMBER FOR A SERIES, 2ND NUM FOR FIXED SPACE ".
50 IF(K.NE.' ')GO TO 51
IF(KA.NE.1)GO TO 10
C DEFAULT NAME IS 'TMP 1'
K='TMP'
MLL=1
51 IF(K.EQ.'99')GO TO 140
C 99=BACKUP
31 IF(LOOKF(K))GO TO 56
C JUMP IF FILE FOUND
TYPE 55
GO TO 15
55 FORMAT(' FILE NOT FOUND'/)
11 FORMAT(A5,I,F)
56 IF(MLL.LT.99)GO TO 560
MLL=0
561 K=K+2
C TYPE 'AAAAA 99' TO FIND ALL IN 'AAAAx' SERIES AUTOMATICALLY
MLL=MLL+1
IF(LOOKF(K))GO TO 561
C KEEPS GOING BACK IF FILES ARE FOUND
K=K-2
560 NMS(KA)=K
IF(MLL.EQ.0)GO TO 5
R8='Y'
IF(RSPC.NE.0)R8=RSPC
GO TO 21
5 TYPE 8
ACCEPT FA5,R8
IF(R8.EQ.'99')GO TO 15
IF(R8.NE.'Y')R8=0
IF(R8.EQ.0)REREAD F78F,R8
C MOVE NUMBER CAN BE TYPED FOR 'MOVE UP'
21 RMOV1(KA+1)=R8
RMOV2(KA)=R8
GO TO 3
140 KA=KA-1
GO TO 15
10 KB=KA-1
IF(I3.NE.'G')GO TO 22
RSIZ=1
GO TO 222
22 TYPE 9
ACCEPT F78F,RSIZ,R9
C SET R9 TO 1 FOR HEAVY STAFF LINES (FOR XGP MAINLY)
IF(RSIZ.EQ.99)GO TO 5
IF(RSIZ.EQ.0)RSIZ=1.
TYPE 550
ACCEPT 11,JJ
IF(JJ.EQ.' ')JJ='PLT'
550 FORMAT(' TYPE OUTPUT NAME - '$)
222 KA=0
1 IF(NAME.NE.0)GO TO 12
IF(KA.NE.KB)GO TO 13
I2=-1
RETURN
C THE END OF THE DATA
13 NAME=NMS(KA+1)
TYPE 111,NAME
RETURN
12 KA=KA+1
NAME=0
R8=0
R2=RSIZ
R3=RSIZ
C FOR FILLER. SIZES .LT. 1.6 = EVERY SCAN LINE, .LT. 2.6 = 2, ETC.
R7=0
R5=1
R6=1
IF(RMOV2(KA).NE.'Y')R7=RMOV2(KA)
IF(RMOV1(KA).NE.0)R5=0
IF(RMOV2(KA).NE.0)GO TO 77
IF(R7.EQ.0)RETURN
77 R6=0
2 FORMAT(' TYPE FILE NAME',I2,1X$)
8 FORMAT(' MOVE UP AT END? ',$)
9 FORMAT(' SIZE FACTOR? ',$)
111 FORMAT(1XA5/)
END
C****** CHANGE 3, 4 AND 5 TO JFCL IN DDT WHEN USING DISTORTION.(SEE 'LINES')
SUBROUTINE FILLMS(L,IDAT,R2,CENTR,R6,R7)
COMMON/DL/RSIZ,SAVER,NAME
COMMON/DST/BB,CC/FLM/X(600)
DIMENSION IDAT(1),NX(600)
EQUIVALENCE (NX,X)
COMMON/PLTR/IPLT,RHT,DIS/LL/LL/STF/RR(8),RSTJ2
C MD=DISPLAY MP=PLOTTER MX=XGP
DATA M2/2/
DX=DIS
RX=RHT
D=RSTJ2*R6
R=RSTJ2*R7
4 GO TO 1
C=CC
B=BB
C SAVES IT. IT WILL RETURN LATER.
BB=B/DIS
CC=1000
1 KK=-2
DO 205 J=1,L
KK=KK+3
KX=KK+2
CALL UNPACK(M,N,IDAT(J))
NX(KX)=2
IF(LL.EQ.3)NX(KX)=3
X(KK)=(R2+D*M)*DIS
CC X(KK)=ROFF((R2+D*M)*DIS)
CC X(KK+1)=ROFF((CENTR+R*N)*RHT)
X(KK+1)=(CENTR+R*N)*RHT
3 GO TO 205
X(KK+1)=X(KK+1)*(C-BB*(ABS(X(KK))))
C FOR DISTORTION
205 CONTINUE
NX(3)=KX
DIS=1.0
RHT=DIS
IF(IPLT)M=RSIZ+.4
IF(M.LE.0)M=1
IF(M.GT.M2)M=M2
C STOPS DISTORTION IN 'LINES'
2 CALL FILLER(NX,M)
DIS=DX
RHT=RX
5 RETURN
C NEXT TO RESET DISTORTION FACT.
BB=B
CC=C
RETURN
END
CC SUBROUTINE PLOT(J,K,L)
CC CALL PLOTX(J,K,L)
CC END
C TO ROTATE 90 DEG. CHANGE IN DDT AT 1M - 'JUMP J' TO 'JUMP K' AND VS-VS.
CF SUBROUTINE PLOT(I,J,K)
CF COMMON /OUTF/JJ
CF DIMENSION N(128)
CF IF(JJ.EQ.-1)GO TO 4
CF L=1
CF N(1)=127
CC IF(JJ.EQ.' ')JJ='PLT'
CF CALL PUTFIL(JJ)
CF JJ=-1
CF4 IF(K.EQ.99)GO TO 1
CF L=L+1
CF CALL PAC(N(L),I)
CC N(L)=J+5000+(I+5000)*10000+(K+4)*100000000
C PACKS PX000Y000
CF3 IF(L.LT.128)RETURN
CF2 CALL FASTOU(N,128)
CF L=1
CF RETURN
CF1 N(1)=L
CF J=N(L)
CF DO 100 JJ=L,128
CF100 N(JJ)=J
CF CALL FASTOU(N,128)
CF CALL FINFIL
CF JJ=0
CF CALL EXIT
CF END
CF SUBROUTINE PLOTS(K)
C DUMMY
CF END